home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / perl4.tcl < prev    next >
Text File  |  1996-08-15  |  5KB  |  139 lines
  1.  
  2. if {![info exists perlDocs]} {
  3.     set perlDocs "$HOME:Help:Perl Commands"
  4. }
  5.  
  6. ##############################################################################
  7. # Colorization setup
  8. #
  9. # Keywords are separated here according to their location in "Perl Commands",
  10. # for the convenience of the cmd-double-click mechanism.
  11. #
  12. # Expression words are described in the "Compound Statements" section
  13. #
  14. set perlExprWords {  
  15. else elsif for foreach if return unless until while eq ne cmp lt gt le ge
  16. }
  17.  
  18. # Special variables are described in their own section (and are not 
  19. # individually marked, so we have to search for them.)
  20. #
  21. # This group can safely be colorized...
  22. #
  23. set perlNameWords {
  24. @_ $_ $.  $/ $, $" $\\ $\# $% $= $- $~ $^ $| $$ $? $& $` $' $+ $* 
  25. $0 $1 $2 $3 $4 $5 $6 $7 $8 $9 $[ $] $; $! $@ $< $> $( $) $:
  26. }
  27.  
  28. #... while this group is forced lower-case by the current colorization scheme
  29. #
  30. set perlSpecialVars [concat $perlNameWords {
  31. $^D $^F $^I $^P $^T $^W $^X 
  32. $ARGV @ARGV @INC %INC @INC %ENV $SIG $ENV %SIG
  33. }]
  34.  
  35. # Perl operators and functions are indexed via the Marks menu
  36. #
  37. set perlKeyWords {
  38.     accept alarm atan2 bind binmode caller chdir chmod chop chown chroot 
  39.     close closedir connect continue cos crypt dbmclose dbmopen defined 
  40.     delete die do dump each   eof eval exec exit exp fcntl fileno 
  41.     flock  fork getc getlogin getpeername getpgrp getppid 
  42.     getpriority getgrnam gethostbyname getnetbyname getprotobyname getpwuid 
  43.     getgrgid getservbyname gethostbyaddr getnetbyaddr getprotobynumber 
  44.     getservbyport getpwent getgrent gethostent getnetent getprotoent 
  45.     getservent setpwent setgrent sethostent setnetent setprotoent setservent 
  46.     endpwent endgrent endhostent endnetent endprotoent endservent 
  47.     getsockname getsockopt gmtime goto grep hex  index int ioctl join keys 
  48.     kill last  length link listen local localtime log lstat lstat mkdir 
  49.     msgctl msgget msgsnd msgrcv next oct open opendir ord pack pipe pop 
  50.     print  printf  push q qq qx rand read readdir readlink recv redo
  51.      rename require reset  reverse rewinddir rindex rindex rmdir 
  52.     scalar seek seekdir select semctl semget semop send setpgrp setpriority 
  53.     setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep 
  54.     socket socketpair sort splice split sprintf sqrt srand stat study sub 
  55.     substr symlink syscall sysread system syswrite tell telldir time times 
  56.     tr truncate umask undef  unlink unpack unshift  utime values 
  57.     vec wait waitpid wantarray warn  write 
  58. }
  59. set perlWords [concat $perlKeyWords $perlNameWords $perlExprWords]
  60. regModeKeywords -e {#} -c red -k blue -s [set PerlmodeVars(stringColor)] Perl  $perlWords
  61. unset perlWords
  62.  
  63. ##############################################################################
  64. # Cmd-double-click support for Perl mode. 
  65. # 
  66. proc PerlDblClick {from to} {
  67.     global HOME perlKeyWords perlSpecialVars perlExprWords
  68.     global perlSearchPath
  69.     
  70.     set pc  [lookAt [expr $from - 1]]
  71.     set ppc [lookAt [expr $from - 2]]
  72.     set tc  [lookAt $to]
  73.     
  74.     # Extend selection to include special characters
  75.     #
  76.     if {$pc == {$}} { 
  77.         if {$from == $to} { incr to }
  78.         incr from -1
  79.         if {$tc == {^}} { incr to }
  80.         
  81.     } elseif {$pc == {^} && $ppc == {$}} {
  82.         incr from -2
  83.         
  84.     } elseif {$pc == {%} || $pc == {@}} {
  85.         incr from -1
  86.     }
  87.     
  88.     # Return if there's no selected text
  89.     if {$to > $from} {
  90.         select $from $to
  91.         set text [getSelect]
  92.         set qtext [quoteExpr $text]
  93.     } else {
  94.         return
  95.     }
  96.  
  97.     set perlSearchPath {}
  98.     
  99.     # Function call
  100.     if {$pc == "&"} {
  101.          if {![catch {search -f 1 -r 1 -m 0 -s "sub *$qtext *\{" 0} mtch]} {
  102.              pushMark
  103.              eval select $mtch
  104.              message "Use Ctl-. to return to original position"
  105.          } else {
  106.              message {Sub definition not found}
  107.          }
  108.  
  109.     # Look up keywords in the man page by their file marks
  110.     } elseif {[lsearch -exact $perlKeyWords $text] >= 0} {
  111.         editMark "$HOME:Help:Perl Commands" $text
  112.  
  113.     # Special vars aren't marked, so search for their definitions
  114.     } elseif {[lsearch -exact $perlSpecialVars $text] >= 0} {
  115.         if {[lsearch -exact [winNames] "Perl Commands"] >= 0} {
  116.             bringToFront "Perl Commands"
  117.         } else {
  118.             edit "$HOME:Help:Perl Commands"
  119.         }
  120.         if {![catch {search -f 0 -r 0 -m 0 -i 0 -s "     $text  " [maxPos]} mtch]} {
  121.             goto [lindex $mtch 0]
  122.         }
  123.  
  124.     # Flow control statements don't have separate entries
  125.     } elseif {[lsearch -exact $perlExprWords $text] >= 0} {
  126.         editMark "$HOME:Help:Perl Commands" "Compound statements"
  127.     
  128.     # If user clicked the arg of a 'require' command, open the file
  129.     } elseif {![catch {perlFindRequire $from $to} filename]} {
  130.         openPerlFile $filename
  131.  
  132.     # Other
  133.     } else {
  134.         select $from $to
  135.         message {Command-double-click on keywords, special vars, and req'd filenames}
  136.     }
  137.  
  138. }
  139.